home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / dspdep.arc / CPP1731.RPG < prev    next >
Encoding:
Text File  |  1991-12-04  |  11.7 KB  |  297 lines
  1.       /TITLE  Display Data Base file dependencies.
  2.       *
  3.       *       Program - CPP1731  (Called by CPP1730)
  4.       *
  5.       *       (c) Copyright 1984 by Q38
  6.       *
  7.      FCPP1731 CF  E                    WORKSTN
  8.      F                                        RRN   KSFILE CPP1731D
  9.       /SPACE
  10.       *   Use QADSPDBR to get DSPDBR OUTFILE format.
  11.      FQADSPDBRIF  E                    DISK
  12.      E                    FL         21 01               File.Library
  13.      E                    CM         80 01               Command to Exec.
  14.      IFILEDS      DS
  15.      I                                       01  10 WHRFI
  16.      I                                       11  20 WHRLI
  17.      I                                       21  30 WHRMB
  18.      I                                       31  40 WHRRD
  19.      IFILIBR      DS
  20.      I                                       01  10 FILE
  21.      I                                       11  20 LIBR
  22.      IINTPGM      DS
  23.      I                                       01  10 INTP
  24.      I                                       11  20 INTL
  25.      I           SDS
  26.      I                                     *PROGRAM PGMSGQ
  27.      I                                       40  46 MSGID
  28.      C           *ENTRY    PLIST
  29.      C                     PARM           FILIBR
  30.      C                     PARM           MBR    10
  31.      C                     PARM           RCDFMT
  32.      C                     PARM           INTPGM
  33.      C/SPACE
  34.      C           *LIKE     DEFN FILEDS    OLD
  35.      C           *LIKE     DEFN *IN01     SECOND
  36.      C                     MOVEL'0'       SECOND
  37.      C/SPACE
  38.      C*   If interupt program requested,
  39.      C*   build qualified program name.
  40.      C           INTP      IFEQ '*NONE'
  41.      C                     MOVELINTP      INTNAM
  42.      C                     ELSE
  43.      C           INTL      IFEQ '*LIBL'
  44.      C                     MOVELINTP      INTNAM
  45.      C                     ELSE
  46.      C                     MOVEAINTP      FL,1
  47.      C                     Z-ADD1         X
  48.      C           *BLANK    LOKUPFL,X                     50
  49.      C                     MOVEL'.'       FL,X
  50.      C                     ADD  1         X
  51.      C                     MOVEAINTL      FL,X
  52.      C                     MOVEAFL,1      INTNAM 21
  53.      C                     END
  54.      C                     END
  55.      C                     Z-ADD0         X
  56.      C                     MOVEA*BLANKS   FL
  57.      C           MBR       IFEQ '*NONE'
  58.      C                     MOVEL'1'       *IN65
  59.      C                     MOVEL'1'       *IN42
  60.      C                     END
  61.      C/SPACE
  62.      C           READF     TAG
  63.      C                     READ QADSPDBR                 32
  64.      C           *IN32     IFEQ '0'
  65.      C           SECOND    IFEQ '1'
  66.      C           FILEDS    CABNEOLD       DSPDBR
  67.      C                     ELSE
  68.      C                     MOVELFILEDS    OLD
  69.      C                     MOVEL'1'       SECOND
  70.      C                     END
  71.      C                     ELSE
  72.      C/SPACE
  73.      C           RRN       CABLT1         EXIT
  74.      C                     GOTO DSPDBR
  75.      C                     END
  76.      C/SPACE
  77.      C                     ADD  1         RRN     50
  78.      C           RRN       IFEQ 1
  79.      C                     MOVEL'0'       *IN21
  80.      C                     WRITECPP1731C
  81.      C                     END
  82.      C/SPACE
  83.      C           WHTYPE    IFEQ 'D'
  84.      C                     MOVEL'DATA'    TYPE
  85.      C                     ELSE
  86.      C           WHTYPE    IFEQ 'A'
  87.      C                     MOVEL'ACCESS'  TYPE
  88.      C                     ELSE
  89.      C                     MOVEL'*FILE'   TYPE
  90.      C                     END
  91.      C                     END
  92.      C                     MOVELWHREFI    OLDFIL
  93.      C                     MOVELWHREMB    OLDMBR
  94.      C/SPACE
  95.      C                     WRITECPP1731D
  96.      C                     GOTO READF
  97.      C/SPACE
  98.      C           DSPDBR    TAG
  99.      C           *IN21     IFEQ '0'
  100.      C                     WRITECPP1731B
  101.      C           *IN32     IFEQ '0'
  102.      C                     MOVELFILEDS    OLD              Save next DS
  103.      C                     READPQADSPDBR                 32
  104.      C                     END
  105.      C                     MOVEL'1'       *IN21
  106.      C                     END
  107.       /SPACE
  108.      C                     WRITEMSGCTL
  109.      C                     EXFMTCPP1731C
  110.      C           *IN01     CABEQ'1'       EXIT
  111.      C                     MOVEL'0'       *IN53
  112.      C                     CALL 'CLRPGMQ'                53
  113.      C/SPACE
  114.      C           *IN05     IFEQ '1'
  115.      C                     Z-ADD0         RRN
  116.      C                     MOVEL'0'       SECOND
  117.      C                     GOTO READF
  118.      C                     END
  119.      C/SPACE
  120.      C           READC     TAG
  121.      C                     MOVEL'0'       *IN53
  122.      C                     READCCPP1731D                 33
  123.      C           *IN33     CABEQ'1'       DSPDBR
  124.       /SPACE
  125.      C           WHREFI    IFNE '*Deleted'
  126.      C           WHREMB    IFNE '*Removed'
  127.      C                     MOVEA*ALL' '   CM
  128.       /SPACE
  129.       *   If an OPTion was entered, then
  130.       *   call interupt program, passing to it
  131.       *   the File/member data.
  132.       *
  133.       *   Q38 has supplied the follow in-line funtions.
  134.       *                8 - RMVM       Remove member.
  135.       *                9 - DLTF       Delete file.
  136.       *                MDT of File    Rename File
  137.       *                MDT of Member  Rename Member
  138.       /SPACE
  139.      C           *IN61     CASEQ'1'       RNMOBJ           Rename File
  140.      C           *IN62     CASEQ'1'       RNMM             Rename Member
  141.      C           OPT       CASEQ'8'       RMVM             Remove member
  142.      C           OPT       CASEQ'9'       DLTF             Delete file.
  143.      C           OPT       CASNE*BLANK    EXECPG           Interupt prog.
  144.      C                     END
  145.       /SPACE
  146.      C                     END
  147.      C                     END
  148.       /SPACE
  149.      C                     MOVEL' '       OPT
  150.      C                     UPDATCPP1731D
  151.      C                     MOVEA'00'      *IN,41
  152.      C                     GOTO READC
  153.      C           EXIT      TAG
  154.      C                     MOVEL'1'       *INLR
  155.       /SPACE
  156.      CSR         RNMOBJ    BEGSR
  157.       *
  158.      C           WHREFI    IFNE '*Deleted'
  159.      C           WHREFI    ANDNE*BLANKS
  160.       *
  161.      C                     MOVEA*BLANKS   FL
  162.      C                     MOVEAOLDFIL    FL
  163.      C                     Z-ADD1         X       50
  164.      C           *BLANK    LOKUPFL,X                     50
  165.      C                     MOVEL'.'       FL,X
  166.      C                     ADD  1         X
  167.      C                     MOVEAWHRELI    FL,X
  168.       *
  169.      C                     MOVEA*BLANKS   CM
  170.      C                     MOVEA'RNMOBJ'  CM,1
  171.      C                     MOVEAFL,1      CM,11
  172.      C                     MOVEA'*FILE'   CM,35
  173.      C                     MOVEAWHREFI    CM,45
  174.       *
  175.      C                     EXSR EXECMD                     EXECUTE COMMAND
  176.      C           *IN53     IFEQ '0'
  177.      C                     MOVE WHREFI    OLDFIL
  178.      C                     ELSE
  179.      C                     MOVE OLDFIL    WHREFI
  180.      C                     END
  181.      C                     END
  182.       *
  183.      CSR         ENDRNM    ENDSR
  184.       /SPACE
  185.      CSR         RNMM      BEGSR
  186.       *
  187.      C           WHREFI    IFNE '*Deleted'
  188.      C           WHREMB    IFNE '*Removed'
  189.       *
  190.      C                     MOVEA*BLANKS   FL
  191.      C                     MOVEAWHREFI    FL
  192.      C                     Z-ADD1         X       50
  193.      C           *BLANK    LOKUPFL,X                     50
  194.      C                     MOVEL'.'       FL,X
  195.      C                     ADD  1         X
  196.      C                     MOVEAWHRELI    FL,X
  197.       /SPACE
  198.      C                     MOVEA*BLANKS   CM
  199.      C                     MOVEA'RNMM  '  CM,1
  200.      C                     MOVEAFL,1      CM,11
  201.      C                     MOVEAOLDMBR    CM,35
  202.      C                     MOVEAWHREMB    CM,60
  203.       /SPACE
  204.      C                     EXSR EXECMD                     EXECUTE COMMAND
  205.      C           *IN53     IFEQ '0'
  206.      C                     MOVE WHREMB    OLDMBR
  207.      C                     ELSE
  208.      C                     MOVE OLDMBR    WHREMB
  209.      C                     END
  210.      C                     END
  211.      C                     END
  212.       /SPACE
  213.      CSR         ENDMBR    ENDSR
  214.       /SPACE
  215.      CSR         RMVM      BEGSR
  216.       /SPACE
  217.      C           WHREFI    IFNE '*Deleted'
  218.      C           WHREMB    IFNE '*Removed'
  219.      C                     MOVEA*BLANKS   FL
  220.      C                     MOVEAWHREFI    FL
  221.      C                     Z-ADD1         X       50
  222.      C           *BLANK    LOKUPFL,X                     50
  223.      C                     MOVEL'.'       FL,X
  224.      C                     ADD  1         X
  225.      C                     MOVEAWHRELI    FL,X
  226.       /SPACE
  227.      C                     MOVEA*BLANKS   CM
  228.      C                     MOVEA'RMVM '   CM
  229.      C                     MOVEAFL,1      CM,11
  230.      C                     MOVEAWHREMB    CM,35
  231.      C                     EXSR EXECMD                     EXECUTE COMMAND
  232.      C           *IN53     IFEQ '0'
  233.      C                     MOVEL'1'       *IN42
  234.      C                     MOVE *BLANKS   WHREMB
  235.      C                     MOVEL'*Removed'WHREMB
  236.      C                     END
  237.      C                     END
  238.      C                     END
  239.       /SPACE
  240.      CSR         ENDRMV    ENDSR
  241.       /SPACE
  242.      CSR         DLTF      BEGSR
  243.       /SPACE
  244.      C           WHREFI    IFNE '*Deleted'
  245.      C                     MOVEA*BLANKS   FL
  246.      C                     MOVEAWHREFI    FL
  247.      C                     Z-ADD1         X       50
  248.      C           *BLANK    LOKUPFL,X                     50
  249.      C                     MOVEL'.'       FL,X
  250.      C                     ADD  1         X
  251.      C                     MOVEAWHRELI    FL,X
  252.       /SPACE
  253.      C                     MOVEA*BLANKS   CM
  254.      C                     MOVEA'DLTF '   CM,1
  255.      C                     MOVEAFL,1      CM,11
  256.      C                     EXSR EXECMD                     EXECUTE COMMAND
  257.      C           *IN53     IFEQ '0'
  258.      C                     MOVEA'11'      *IN,41
  259.      C                     MOVE *BLANKS   WHREFI
  260.      C                     MOVEL'*Deleted'WHREFI
  261.      C                     END
  262.      C                     END
  263.       /SPACE
  264.      CSR         ENDDLT    ENDSR
  265.       /SPACE
  266.      CSR         EXECMD    BEGSR
  267.       /SPACE
  268.      C                     MOVEACM        CMD
  269.      C                     CALL 'QCAEXEC'              53
  270.      C                     PARM           CMD    80
  271.      C                     PARM 80        LENGTH 155
  272.       /SPACE
  273.      CSR         ENDCMD    ENDSR
  274.       /SPACE
  275.      CSR         EXECPG    BEGSR
  276.       /SPACE
  277.      C           *LIKE     DEFN WHREFI    FIL
  278.      C           *LIKE     DEFN WHRELI    LIB
  279.      C           *LIKE     DEFN WHREMB    MEMBER
  280.      C           *LIKE     DEFN WHRRD     RECD
  281.      C           *LIKE     DEFN WHTYPE    DEPTYP
  282.      C           *LIKE     DEFN OPT       OPTION
  283.       /SPACE
  284.      C           INTNAM    IFEQ '*NONE'
  285.      C                     MOVEL'1'       *IN53
  286.      C                     ELSE
  287.      C                     CALL INTNAM                 53
  288.      C                     PARM OPT       OPTION
  289.      C           WHREFI    PARM WHREFI    FIL
  290.      C           WHRELI    PARM WHRELI    LIB
  291.      C           WHREMB    PARM WHREMB    MEMBER
  292.      C           WHRRD     PARM WHRRD     RECD
  293.      C                     PARM WHTYPE    DEPTYP
  294.      C                     END
  295.       /SPACE
  296.      CSR         ENDINT    ENDSR
  297.